home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / Pete Johnson / Log-O-Matic 1.72<source> Folder / Log-O-Matic.p < prev    next >
Encoding:
Text File  |  1991-07-25  |  30.9 KB  |  1,071 lines  |  [TEXT/PJMM]
  1. program LogOMat;
  2.  
  3. {    Program to backup, sort and zero user minutes in a Red Ryder Host UserLog        }
  4. {    and to reset CallerLog and TabbyLog.                                                    }
  5.  
  6. {    Written by Pete Johnson for the    Glassell Park BBS 213-254-4133                }
  7.  
  8. {    Version 1.8                                                                                    }
  9.  
  10. {    Date of last revision: Jan. 27, 1991                                                        }
  11.  
  12. {    Known bugs:        Alter veteran users doesn't set or clear flags right.                }
  13. {                        BU Tabby log by days not implemented.                                }
  14. {                        Monthly Tabby.Arch not implemented.                                }
  15. {                        Need to rework so that BackupPath is used for all archives.        }
  16.  
  17.     uses
  18.         Globals, HelloTabby, ConfigureLOM;
  19.  
  20.     const
  21.         ARRAYLIMIT = 3000;
  22.         DAYSECS = 86400;        {    hours * mins * secs in a day    }
  23.         DELETED = 64;
  24.         MySignature = longint('LMat');
  25.  
  26.         runDlog = 1001;            { Resource type: DLOG }
  27.  
  28.         nextLaunchStr = 500;            { Resource type: STR  }
  29.         defaultsStr = 501;
  30.         BackupPathStr = 504;
  31.         veteranStr = 505;
  32.         flagStr = 506;
  33.         textTypeStr = 507;
  34.         levelToDeleteStr = 508;
  35.         promotionStr = 509;
  36.         tabbyLogArchLimitStr = 510;
  37.         oneCallLimitStr = 511;
  38.         deleteOldUsersStr = 512;
  39.         checkLevelStr = 513;
  40.         None = 0;{ no compression}
  41.         Faster = 1;{ faster compression}
  42.         Fast = 2;{ fast compression}
  43.         Better = 3;{ better compression}
  44.         Optimal = 4;{ optimal compression - 1.1 or later}
  45.         BestGuess = 5;{ best guess- faster, but not always as good - 1.1 or later}
  46.  
  47.     type
  48.         WhenCalled = packed array[1..6] of char;
  49.         UserRecord = packed record
  50.                 FirstName: string[15];
  51.                 LastName: string[15];
  52.                 CallingFromAndPW: packed array[1..40] of char;
  53.                 NumberOfCalls: integer;
  54.                 DateLastCalled: WhenCalled;
  55.                 TCMRRF: packed array[1..6] of char;    {Time, Clearance, Minutes last call, Reserved, Reserved, Flags}
  56.                 Uploads: integer;
  57.                 Downloads: integer;
  58.                 PrivMsg: integer;
  59.                 PubMsg: integer;
  60.                 MRRF: packed array[1..6] of char;
  61.                 HiMsgRead: longint;
  62.                 CombinedReads: packed array[1..32] of char
  63.             end;
  64.         FileSpecPtr = ^FileSpec;
  65.         FileSpec = record
  66.                 v: Integer;{ volume refNum}
  67.                 d: Longint;{ directory id}
  68.                 n: string[31];{ file/folder name}
  69.                 method: signedbyte;{ comp method - used in compression only}
  70.                 deleteIt: boolean;{ delete original file/folder when done?}
  71.             end;
  72.         FileListHdl = ^FileListPtr;
  73.         FileListPtr = ^FileListRec;
  74.         FileListRec = record
  75.                 count: integer;{ # of files/folders below}
  76.                 ary: array[0..0] of filespec;{ array of files to act on}
  77.             end;
  78.  
  79.     var
  80.         ThisUser: UserRecord;
  81.         DialogPointer: DialogPtr;
  82.         fndrInfo: FInfo;
  83.         NewRefNum, ULRefNum, Count, StuffRef: integer;
  84.         logicalEOF, ULRecSize: longint;
  85.         Today: DateTimeRec;
  86.         ResourceHandle: StringHandle;
  87.         StuffResource: Handle;
  88.         savePort: GrafPtr;
  89.         dispRect: rect;
  90.  
  91. {-----------------------------------------------------------------    }
  92.  
  93.     function GetDirInfo (ourPath: str255; var ourVRef: integer): OSErr;
  94.  
  95.         var
  96.             i: integer;
  97.             ourDirRef: longint;
  98.             myWDPBRec: WDPBRec;
  99.             Error: OSErr;
  100.             tempString: str255;
  101.  
  102.     begin
  103.         while (ourPath[length(ourPath)] <> ':') & (length(ourPath) > 1) do
  104.             ourPath := copy(ourPath, 1, length(ourPath) - 1);
  105.         tempString := ourPath;        {make an extra copy since HGetVol truncates the string}
  106.         Error := HGetVol(@tempString, ourVRef, ourDirRef);
  107.         with myWDPBRec do
  108.             begin
  109.                 ioNamePtr := @ourPath;
  110.                 ioVRefNum := ourVRef;
  111.                 ioWDDirID := ourDirRef;
  112.                 ioWDProcID := MySignature;
  113.                 Error := PBOpenWD(@myWDPBRec, false);
  114.                 if ioVRefNum <> vRefNum then    {StuffIt doesn't like being fed a working    }
  115.                     ourVRef := ioVRefNum            {directory when file is in default directory    }
  116.             end;
  117.         GetDirInfo := Error
  118.     end;
  119.  
  120. {-----------------------------------------------------------------    }
  121.  
  122.     procedure CloseWD (tempVRef: longint);
  123.  
  124.         var
  125.             myWDPBRec: WDPBRec;
  126.  
  127.     begin
  128.         with myWDPBRec do
  129.             begin
  130.                 ioNamePtr := nil;
  131.                 ioVRefNum := tempVRef;
  132.                 ioWDIndex := 0;
  133.                 Err := PBCloseWD(@myWDPBRec, false)
  134.             end
  135.     end;
  136.  
  137. {-----------------------------------------------------------------    }
  138.  
  139.     function GetPath (Input: str255): str255;
  140.  
  141.     begin
  142.         while not (Input[length(Input)] in [':']) & (length(Input) > 1) do
  143.             Input := copy(Input, 1, length(Input) - 1);
  144.         if length(Input) = 1 then
  145.             Input := ':';
  146.         GetPath := Input
  147.     end;
  148.  
  149. { ------------------------------------------------------ }
  150.  
  151.     function Stuff (theFiles: FileListHdl; { list of files to compress}
  152.                                     destFile: FileSpecPtr; { result file name/location}
  153.                                     title: Str255;   { title of progress windows}
  154.                                     Addr: Ptr): OSErr;  { address to jump to (start of the resource)}
  155.     inline
  156.         $205F, $4E90; { pop last param & jump to it}
  157.  
  158. {-----------------------------------------------------------------    }
  159.  
  160.     function FindStuffIt: boolean;
  161.  
  162.         var
  163.             error: OSErr;
  164.             theWorld: SysEnvRec;
  165.             CheckRef, origVRef, StuffVRef: integer;
  166.  
  167.     begin
  168.         error := GetVol(nil, origVRef);
  169.         error := SysEnvirons(1, theWorld);
  170.         StuffVRef := theWorld.sysVRefNum;    {it's in the System Folder}
  171.         error := SetVol(nil, StuffVRef);
  172.         if error = noErr then
  173.             StuffRef := OpenResFile(':Extensions:StuffIt Engine™');
  174.         if (StuffRef <> -1) then
  175.             begin
  176.                 StuffResource := NewHandle(sizeOf(Handle));
  177.                 StuffResource := Get1IndResource('MENC', 1);
  178.                 GetPort(savePort); { Only needed when calling v1.0 of the engine}
  179.             end;
  180.         error := SetVol(nil, origVRef);
  181.         if (error = noErr) & (StuffRef <> -1) then
  182.             FindStuffIt := true
  183.         else
  184.             FindStuffIt := false
  185.     end;
  186.  
  187. {-----------------------------------------------------------------    }
  188.  
  189.     procedure CloseStuffIt;
  190.  
  191.     begin
  192.         ReleaseResource(StuffResource);
  193.         CloseResFile(StuffRef);
  194.         if StuffResource <> nil then
  195.             DisposHandle(StuffResource);
  196.     end;
  197.  
  198. {-----------------------------------------------------------------    }
  199.  
  200.     function Int2Char (Number: integer): char;
  201.  
  202. { Function changes integer to character.                                }
  203.  
  204.     begin
  205.         Int2Char := chr(Number + ord('0'))
  206.     end;
  207.  
  208. { ------------------------------------------------------ }
  209.  
  210.     function BigString (Number: integer): string;
  211.  
  212. { Function changes two-digit number to a two-character string.           }
  213.  
  214.     begin
  215.         BigString := concat(Int2Char(Number div 10), Int2Char(Number mod 10))
  216.     end;
  217.  
  218. { ------------------------------------------------------ }
  219.  
  220.     procedure Wr (fref: integer; length: longint; thepointer: Ptr);
  221.  
  222.     begin
  223.         Err := FSWrite(fref, length, thepointer)
  224.     end;
  225.  
  226. { ------------------------------------------------------ }
  227.  
  228.     function WrLn (fref: integer; theStr: str255): OSErr;
  229.         var
  230.             CR: signedByte;
  231.  
  232.     begin
  233.         CR := 13;
  234.         Wr(fref, length(theStr), pointer(ord(@theStr) + 1));
  235.         Wr(fref, 1, @CR)
  236.     end;
  237.  
  238. { ------------------------------------------------------ }
  239.  
  240.     procedure MakeDateline;
  241.  
  242.     begin
  243.         GetTime(Today);
  244.         Date2Secs(Today, NowSecs);
  245. { The BigString function in the following section turns a two-digit integer            }
  246. { into a two-character string. If there are fewer than two digits, the string        }
  247. { contains a leading '0'.                                                                     }
  248.  
  249.         DateString := concat(BigString(Today.Month), '/');
  250.         DateString := concat(DateString, BigString(Today.Day), '/');
  251.         DateString := concat(DateString, BigString(Today.Year - 1900))
  252.  
  253.     end;
  254.  
  255. { ------------------------------------------------------ }
  256.  
  257.     procedure GetSTR;
  258.  
  259.         var
  260.             TheString: str255;
  261.             CommaPlace: integer;
  262.  
  263.     begin
  264.         TheString := GetString(defaultsStr)^^;
  265.  
  266.         while length(TheString) < 14 do
  267.             TheString := concat(TheString, 'Y');
  268.  
  269.         if TheString[1] = 'Y' then
  270.             DeleteByLevel := true
  271.         else
  272.             DeleteByLevel := false;
  273.  
  274.         if TheString[2] = 'Y' then
  275.             SkipDeletes := true
  276.         else
  277.             SkipDeletes := false;
  278.  
  279.         if TheString[3] = 'Y' then
  280.             Backup := true
  281.         else
  282.             Backup := false;
  283.  
  284.         if TheString[4] = 'Y' then
  285.             ZeroMin := true
  286.         else
  287.             ZeroMin := false;
  288.  
  289.         if TheString[5] = 'Y' then
  290.             SortUL := true
  291.         else
  292.             SortUL := false;
  293.  
  294.         if TheString[6] = 'Y' then
  295.             ResetCL := true
  296.         else
  297.             ResetCL := false;
  298.  
  299.         if TheString[7] = 'Y' then
  300.             ResetTL := true
  301.         else
  302.             ResetTL := false;
  303.  
  304.         if TheString[8] = 'Y' then
  305.             MonthlyCLArc := true
  306.         else
  307.             MonthlyCLArc := false;
  308.  
  309.         if TheString[9] = 'Y' then
  310.             LogDeletes := true
  311.         else
  312.             LogDeletes := false;
  313.  
  314.         if TheString[10] = 'Y' then
  315.             KillOldOneCalls := true
  316.         else
  317.             KillOldOneCalls := false;
  318.  
  319.         if TheString[11] = 'Y' then
  320.             AlterVeterans := true
  321.         else
  322.             AlterVeterans := false;
  323.  
  324.         if TheString[12] = 'Y' then
  325.             MonthlyTLArc := true
  326.         else
  327.             MonthlyTLArc := false;
  328.  
  329.         if TheString[13] = 'S' then
  330.             SetTheFlag := true
  331.         else
  332.             SetTheFlag := false;
  333.  
  334.         if TheString[14] = 'K' then
  335.             TLKLimit := true
  336.         else
  337.             TLKLimit := false;
  338.  
  339.         if TheString[15] = 'S' then
  340.             UseStuffit := true
  341.         else
  342.             UseStuffit := false;
  343.  
  344.         DeleteLevelString := GetString(levelToDeleteStr)^^;
  345.         StringToNum(DeleteLevelString, DeleteLevel);
  346.         DeleteLevel := Byte(BitAnd(DeleteLevel, 255));
  347.  
  348.         PromotionString := GetString(promotionStr)^^;        {    format of string is Y9,10,25        }
  349.         Newcomer := 0;                                                {    first letter is 'Y' or 'N'                }
  350.         Approved := 0;                                                {    first integer is Newcomer            }
  351.         NewTime := 0;                                                {    second integer is Approved        }
  352.         if PromotionString[1] = 'Y' then                            {    third integer is NewTime            }
  353.             begin
  354.                 ChangeLevel := true;
  355.                 CommaPlace := pos(',', PromotionString);
  356.                 if CommaPlace > 0 then
  357.                     begin
  358.                         TheString := copy(PromotionString, 2, CommaPlace - 2);     {start at 2 to skip 'Y' or 'N', CommaPlace - 2 is length    }
  359.                         StringToNum(TheString, Newcomer);
  360.                         TheString := copy(PromotionString, CommaPlace + 1, 255);
  361.                         CommaPlace := pos(',', TheString);
  362.                         if CommaPlace > 0 then
  363.                             begin
  364.                                 TempString := copy(TheString, 1, CommaPlace - 1);
  365.                                 StringToNum(TempString, Approved);
  366.                                 TempString := copy(TheString, CommaPlace + 1, 255);
  367.                                 StringToNum(TempString, NewTime)
  368.                             end
  369.                     end
  370.                 else
  371.                     ChangeLevel := false
  372.             end;
  373.  
  374.         TabbyLimitString := GetString(tabbyLogArchLimitStr)^^;        {    format of string is YK100 (number in K) or        }
  375.         if TabbyLimitString[1] = 'Y' then                                {    YD100 with K or D for KBytes or Days.            }
  376.             begin
  377.                 TabbyLimit := true;
  378.                 if TabbyLimitString[2] = 'D' then
  379.                     TLKLimit := false
  380.                 else
  381.                     TLKLimit := true;
  382.                 StringToNum(copy(TabbyLimitString, 3, 255), TabbyLimitSize)
  383.             end
  384.         else
  385.             begin
  386.                 TabbyLimit := false;
  387.                 TabbyLimitSize := 0
  388.             end;
  389.  
  390.         OneCallLimitString := GetString(oneCallLimitStr)^^;
  391.         StringToNum(OneCallLimitString, OneCallLimit);
  392.  
  393.         TheString := GetString(deleteOldUsersStr)^^;        {    format of string is Y100 (number in K)        }
  394.         if TheString[1] = 'Y' then
  395.             begin
  396.                 DeleteOldUsers := true;
  397.                 StringToNum(copy(GetString(deleteOldUsersStr)^^, 2, 255), Inactivity)
  398.             end
  399.         else
  400.             begin
  401.                 DeleteOldUsers := false;
  402.                 Inactivity := 0
  403.             end;
  404.  
  405.         CheckLevStr := GetString(checkLevelStr)^^;        {    format of string is '0' to '255')        }
  406.         StringToNum(CheckLevStr, CheckLevLong);
  407.  
  408.         TEXTType := GetString(textTypeStr)^^;
  409.  
  410.         BackupPath := GetString(BackupPathStr)^^;
  411.  
  412.         VetCallsText := GetString(veteranStr)^^;
  413.         StringToNum(VetCallsText, VetCalls);
  414.  
  415.         FlagNumText := GetString(flagStr)^^;
  416.         StringToNum(FlagNumText, FlagNum);
  417.  
  418.     end;
  419.  
  420. { ------------------------------------------------------ }
  421.  
  422.     function ReadConfig: boolean;
  423.  
  424. {    Reads Config file and returns Path:CallerLog, Path:UserLog, Path:MESSAGES, SysopName    (all caps)    and    }
  425. {    NextLaunchDateRec.                        }
  426.  
  427.         var
  428.             AString: str255;
  429.             VolumeRef, ConfigRefNum: integer;
  430.             FileEnd, CharsToSend, NextLaunchTime: longint;
  431.             ConfigErr: OSErr;
  432.             VolName: STR255;
  433.  
  434.     begin
  435.  
  436.         ConfigErr := GetVol(@VolName, VolumeRef);        { Get volume ref # for default volume }
  437.         ULPath := '';
  438.         if (ConfigErr = NoErr) then
  439.             ConfigErr := FSOpen(':Config', VolumeRef, ConfigRefNum);
  440.         if (ConfigErr = NoErr) then
  441.             ConfigErr := GetEOF(ConfigRefNum, FileEnd);
  442.  
  443.         if (FileEnd > 317) & (ConfigErr = NoErr) then        {    Make sure file is longer than our deepest SetFPos (it should be 349)    }
  444.             begin
  445.                 CharsToSend := 41;
  446.                 ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 57);
  447.                 ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  448.                 if length(AString) > 0 then
  449.                     ULPath := AString
  450.                 else
  451.                     ULPath := '';
  452.                 ULPath := concat(ULPath, ':UserLog');
  453.  
  454.                 CharsToSend := 41;
  455.                 ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 98);
  456.                 ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  457.                 if length(AString) > 0 then
  458.                     CLPath := AString
  459.                 else
  460.                     CLPath := '';
  461.                 CLPath := concat(CLPath, ':CallerLog');
  462.             end;    {    if FileEnd > 317        }
  463.  
  464.         if (ConfigErr = NoErr) then
  465.             ReadConfig := true
  466.         else
  467.             ReadConfig := false;
  468.         ConfigErr := FSClose(ConfigRefNum);
  469.     end;
  470.  
  471. { ------------------------------------------------------ }
  472.  
  473.     procedure SortUserLog;
  474.  
  475.         type
  476.             UserPointer = ^UserRecord;
  477.             UserHandle = ^UserPointer;
  478.             UserArray = array[1..ARRAYLIMIT] of UserHandle;
  479.             SortRecord = record
  480.                     IndexNo: integer;
  481.                     IndexString: packed array[1..7] of char;
  482.                 end;
  483.             SortPointer = ^SortRecord;
  484.             SortHandle = ^SortPointer;
  485.             SortArray = array[1..ARRAYLIMIT] of SortHandle;
  486.  
  487.         var
  488.             TheUserLog: UserArray;
  489.             ThisArray: SortArray;
  490.             UserCount1, UserCount2, SortedUser, ULRef: integer;
  491.             HeadCount: longint;
  492.  
  493.         procedure QuickSort (Start, Finish: integer; var TheArray: SortArray);
  494.  
  495. {    Sorts array Users by Clearance+Date field using QuickSort    }
  496.  
  497.             var
  498.                 Left, Right: integer;
  499.                 StarterValue: packed array[1..7] of char;
  500.                 Temp: SortHandle;
  501.  
  502.         begin
  503.             Left := Start;
  504.             Right := Finish;
  505.             StarterValue := TheArray[(Start + Finish) div 2]^^.IndexString;    {    Pick a starter    }
  506.             repeat
  507.                 while TheArray[Left]^^.IndexString < StarterValue do
  508.                     Left := Left + 1;    {    Find a bigger value on the left    }
  509.                 while StarterValue < TheArray[Right]^^.IndexString do
  510.                     Right := Right - 1;    {    Find a smaller value on the right    }
  511.                 if Left <= Right then
  512.                     begin    {If we haven't gone too far...    }
  513.                         Temp := TheArray[Left];
  514.                         TheArray[Left] := TheArray[Right];
  515.                         TheArray[Right] := Temp;
  516.                         Left := Left + 1;
  517.                         Right := Right - 1
  518.                     end;    {    then    }
  519.             until Right <= Left;
  520.             if Start < Right then
  521.                 QuickSort(Start, Right, TheArray);
  522.             if Left < Finish then
  523.                 QuickSort(Left, Finish, TheArray)
  524.         end;    {    procedure QuickSort    }
  525.  
  526.     begin
  527.         Err := FSOpen(ULPath, vRefNum, ULRef);
  528.         Err := SetFPos(ULRef, fsFromStart, ULRecSize);    {    Sysop is at seek position zero, so we skip it    }
  529.         Err := GetEOF(ULRef, logicalEOF);
  530.         HeadCount := logicalEOF div ULRecSize;
  531.         UserCount1 := 1;
  532.         if (HeadCount <= ARRAYLIMIT) & (HeadCount > 2) then
  533.             begin
  534.                 for UserCount1 := 2 to HeadCount do        {    skip 1 to allow for missing sysop        }
  535.                     begin
  536.                         TheUserLog[UserCount1] := UserHandle(NewHandle(ULRecSize));
  537.                         Err := FSRead(ULRef, ULRecSize, Ptr(TheUserLog[UserCount1]^));
  538.                         ThisArray[UserCount1] := SortHandle(NewHandle(SizeOf(SortRecord)));
  539.                         ThisArray[UserCount1]^^.IndexNo := UserCount1;
  540.                         ThisArray[UserCount1]^^.IndexString := concat(TheUserLog[UserCount1]^^.TCMRRF[2], TheUserLog[UserCount1]^^.DateLastCalled);
  541.                     end;        {    for UserCount1 := 1 to HeadCount - 1    }
  542.  
  543.                 QuickSort(2, HeadCount, ThisArray);
  544.  
  545.                 Err := SetFPos(ULRef, fsFromStart, ULRecSize);    {    Sysop is at seek position zero, so we skip it    }
  546.  
  547.                 for UserCount2 := HeadCount downto 2 do    {    Write in reverse to get proper order    }
  548.                     begin
  549.                         SortedUser := ThisArray[UserCount2]^^.IndexNo;
  550.                         Err := FSWrite(ULRef, ULRecSize, Ptr(TheUserLog[SortedUser]^));
  551.                         DisposHandle(Handle(TheUserLog[SortedUser]));
  552.                         DisposHandle(Handle(ThisArray[UserCount2]));
  553.                     end;        {    for UserCount2 := UserCount1 downto 1    }
  554.  
  555.                 Err := FSClose(ULRef)
  556.             end        {    (HeadCount <= ARRAYLIMIT) & (HeadCount > 2)    }
  557.     end;
  558.  
  559. { ------------------------------------------------------ }
  560.  
  561.     procedure ZeroMinutes;
  562.  
  563.         var
  564.             ZeroMinCount, ByteSize: longint;
  565.             TimeByte: byte;
  566.  
  567.     begin
  568.         TimeByte := 0;
  569.         ByteSize := 1;
  570.         Err := FSOpen(ULPath, vRefNum, ULRefNum);
  571.         Err := GetEOF(ULRefNum, logicalEOF);
  572.         for ZeroMinCount := 1 to (logicalEOF div sizeOf(UserRecord)) do
  573.             begin
  574.                 Err := SetFPos(ULRefNum, fsFromStart, ((ZeroMinCount - 1) * sizeOf(UserRecord)) + 82);
  575.                 Err := FSWrite(ULRefNum, ByteSize, @TimeByte);
  576.             end;
  577.         Err := FSClose(ULRefNum);
  578.     end;
  579.  
  580. { ------------------------------------------------------ }
  581.  
  582.     function UserHasExpired (DateOfLastCall: WhenCalled; DaysAllowed: longint): boolean;
  583.  
  584.         var
  585.             UserDTR: DateTimeRec;
  586.             UserSecs: longint;
  587.  
  588.     begin
  589.         UserDTR.Year := BitAnd(ord(DateOfLastCall[1]), 255) + 1900;
  590.         UserDTR.Month := BitAnd(ord(DateOfLastCall[2]), 255);
  591.         UserDTR.Day := BitAnd(ord(DateOfLastCall[3]), 255);
  592.         UserDTR.Hour := 0;
  593.         UserDTR.Minute := 0;
  594.         UserDTR.Second := 0;
  595.         Date2Secs(UserDTR, UserSecs);
  596.         if (NowSecs - UserSecs) > (DAYSECS * DaysAllowed) then
  597.             UserHasExpired := true
  598.         else
  599.             UserHasExpired := false
  600.     end;
  601.  
  602. { ------------------------------------------------------ }
  603.     procedure GetFromAndPW (var From, PW: str255);
  604.  
  605.         var
  606.             Counter: integer;
  607.  
  608.     begin
  609.         From := '';
  610.         for Counter := 2 to ord(ThisUser.CallingFromAndPW[1]) + 1 do
  611.             From := concat(From, ThisUser.CallingFromAndPW[Counter]);
  612.         PW := '';
  613.         for Counter := 33 to ord(ThisUser.CallingFromAndPW[32]) + 32 do
  614.             PW := concat(PW, ThisUser.CallingFromAndPW[Counter]);
  615.     end;
  616.  
  617. { ------------------------------------------------------ }
  618.  
  619.     procedure WriteDeleteLog (ReasonDeleted: str255);
  620.  
  621.         var
  622.             DeleteRef, Counter: integer;
  623.             ULDeleteFile, Password, FromString, LogString: str255;
  624.  
  625.     begin
  626.         ULDeleteFile := concat(BackupPath, 'Users Deleted');
  627.         Err := FSOpen(ULDeleteFile, vRefNum, DeleteRef);
  628.         if Err <> NoErr then
  629.             begin
  630.                 Err := Create(ULDeleteFile, vRefNum, TEXTType, 'TEXT');
  631.                 Err := FSOpen(ULDeleteFile, vRefNum, DeleteRef);
  632.                 Err := WrLn(DeleteRef, '           Calls    Last       UL   DL  Pub  Pri  Lev  Min   Reason');
  633.             end;
  634.         if Err = NoErr then
  635.             begin
  636.                 Err := SetFPos(DeleteRef, FSFromLEOF, 0);
  637.                 GetFromAndPW(FromString, Password);
  638.                 with ThisUser do
  639.                     begin
  640.                         LogString := concat(FirstName, ' ', LastName, ' from ', FromString);
  641.                         LogString := concat(LogString, '    [', Password, ']', ENDLINE);
  642.                         LogString := concat(LogString, DateString, '    ', StringOf(NumberOfCalls : 4), '  ');
  643.                         LogString := concat(LogString, BigString(ord(DateLastCalled[2])), '/');
  644.                         LogString := concat(LogString, BigString(ord(DateLastCalled[3])), '/');
  645.                         LogString := concat(LogString, BigString(ord(DateLastCalled[1])), '   ');
  646.                         LogString := concat(LogString, StringOf(Uploads : 4), ' ');
  647.                         LogString := concat(LogString, StringOf(Downloads : 4), ' ');
  648.                         LogString := concat(LogString, StringOf(PubMsg : 4), ' ');
  649.                         LogString := concat(LogString, StringOf(PrivMsg : 4), '  ');
  650.                         LogString := concat(LogString, StringOf(ord(TCMRRF[2]) : 3), '  ');
  651.                         LogString := concat(LogString, StringOf(ord(TCMRRF[1]) : 3), '   ', ReasonDeleted)
  652.                     end;    {with ThisUser}
  653.                 Err := WrLn(DeleteRef, LogString)
  654.             end;
  655.         Err := FSClose(DeleteRef)
  656.     end;
  657.  
  658. { ------------------------------------------------------ }
  659.  
  660.     procedure BackUserLog;
  661.  
  662.         const
  663.             MaxBadNames = 100;
  664.             MaxFileChars = 10000;
  665.  
  666.         var
  667.             FilePointer: Ptr;
  668.             tempWD: integer;
  669.  
  670.         var
  671.             ULCounter: longint;
  672.             BadNameFile, HowManyBadNames, Counter, i, ULCopyRefNum: integer;
  673.             BadNames: array[1..MaxBadNames] of string[15];
  674.             GoodUser: boolean;
  675.             ReasonDeleted, SitName: str255;
  676.             StuffFilesHandle: FileListHdl;
  677.             destFile: FileSpec;
  678.             HowManyCharacters, tempDirRef, tempVRef: longint;
  679.  
  680.     begin
  681.         for Counter := 1 to MaxBadNames do
  682.             BadNames[Counter] := '';
  683.         Err := FSOpen('Bad User Names', vRefNum, BadNameFile);
  684.         Counter := 1;
  685.         while (Err = NoErr) & (Counter < MaxBadNames + 1) do
  686.             begin
  687.                 Err := ReadALine(BadNameFile, BadNames[Counter]);
  688.                 if BadNames[Counter] = '' then
  689.                     leave;
  690.                 Counter := succ(Counter);
  691.             end;
  692.         HowManyBadNames := Counter - 1;
  693.         Err := FSClose(BadNameFile);
  694.         NewULog := concat(ULPath, '.$$$');
  695.         TheBAK := concat(ULPath, '.BAK');
  696.         Err := GetFInfo(NewULog, vRefNum, fndrInfo);
  697.         if Err = noErr then
  698.             begin
  699.                 with fndrInfo do
  700.                     begin
  701.                         fndrInfo.fdType := 'ULOG';
  702.                         fndrInfo.fdCreator := 'ULED'
  703.                     end;
  704.                 Err := SetFInfo(NewULog, vRefNum, fndrInfo);
  705.             end
  706.         else
  707.             Err := Create(NewULog, vRefNum, 'ULED', 'ULOG');
  708.         Err := FSOpen(NewULog, vRefNum, NewRefNum);
  709.         Err := SetFPos(NewRefNum, fsFromStart, 0);
  710.         Err := FSOpen(ULPath, vRefNum, ULRefNum);
  711.         Err := GetEOF(ULRefNum, logicalEOF);
  712.         Err := SetFPos(ULRefNum, fsFromStart, 0);
  713.         for ULCounter := 1 to (logicalEOF div ULRecSize) do
  714.             begin
  715.                 Err := FSRead(ULRefNum, ULRecSize, @ThisUser);
  716.                 ReasonDeleted := 'Unknown';
  717.                 if ChangeLevel then
  718.                     if (ThisUser.TCMRRF[2] = chr(Newcomer)) then
  719.                         begin
  720.                             GoodUser := true;
  721.                             for Counter := 1 to HowManyBadNames do
  722.                                 if (EqualString(ThisUser.FirstName, BadNames[Counter], false, false)) | (EqualString(ThisUser.LastName, BadNames[Counter], false, false)) then
  723.                                     GoodUser := false;
  724.                             if GoodUser then
  725.                                 begin
  726.                                     ThisUser.TCMRRF[1] := chr(NewTime);
  727.                                     ThisUser.TCMRRF[2] := chr(Approved)
  728.                                 end
  729.                             else
  730.                                 begin
  731.                                     ThisUser.TCMRRF[1] := chr(0);            {    zero time        }
  732.                                     ThisUser.TCMRRF[2] := chr(0);            {    zero access    }
  733.                                     ThisUser.TCMRRF[6] := chr(DELETED);    {    delete            }
  734.                                     ReasonDeleted := 'Bad Name'
  735.                                 end
  736.                         end;        {    if (ThisUser.TCMRRF[2] = chr(Newcomer))        }
  737.                 if (ord(ThisUser.TCMRRF[2]) <= CheckLevLong) & (ULCounter <> 1) then
  738.                     begin
  739.                         if DeleteOldUsers then
  740.                             if UserHasExpired(ThisUser.DateLastCalled, Inactivity) then
  741.                                 begin
  742.                                     ThisUser.TCMRRF[6] := chr(DELETED);
  743.                                     ReasonDeleted := 'Inactive'
  744.                                 end;
  745.                         if KillOldOneCalls then
  746.                             if (ThisUser.NumberOfCalls < 2) then
  747.                                 if UserHasExpired(ThisUser.DateLastCalled, OneCallLimit) then
  748.                                     if ((ThisUser.Uploads + ThisUser.Downloads + ThisUser.PrivMsg + ThisUser.PubMsg) < 1) then
  749.                                         begin
  750.                                             ThisUser.TCMRRF[6] := chr(DELETED);
  751.                                             ReasonDeleted := 'One-Timer'
  752.                                         end;
  753.                     end;        {    if (ord(ThisUser.TCMRRF[2]) <= CheckLevLong) & (ULCounter <> 1)        }
  754.                 if AlterVeterans & (ThisUser.NumberOfCalls > VetCalls) then
  755.                     if SetTheFlag then
  756.                         ThisUser.MRRF[6 - ((FlagNum - 1) div 8)] := chr(BitOr(ord(ThisUser.MRRF[6 - ((FlagNum - 1) div 8)]), FlagNum mod 8))
  757.                     else
  758.                         ThisUser.MRRF[6 - ((FlagNum - 1) div 8)] := chr(BitXor(ord(ThisUser.MRRF[6 - ((FlagNum - 1) div 8)]), FlagNum mod 8));
  759.                 if (ThisUser.TCMRRF[2] = chr(DeleteLevel)) & DeleteByLevel then
  760.                     ReasonDeleted := 'Bad Level';
  761. {    Next section checks TCMRFF byte 2 to see if clearance is valid and bit 7 of TCMRFF byte 6 to see if user is deleted    }
  762.                 if (ThisUser.TCMRRF[2] <> chr(DeleteLevel)) | (not DeleteByLevel) then
  763.                     if (BitAnd(ord(ThisUser.TCMRRF[6]), DELETED) <> DELETED) | (not SkipDeletes) then
  764.                         Err := FSWrite(NewRefNum, ULRecSize, @ThisUser);
  765.                 if (BitAnd(ord(ThisUser.TCMRRF[6]), DELETED) = DELETED) & SkipDeletes & LogDeletes then
  766.                     WriteDeleteLog(ReasonDeleted);
  767.             end;
  768.         Err := FSClose(ULRefNum);
  769.         Err := FSClose(NewRefNum);
  770.         Err := FSDelete(TheBAK, vRefNum);                        {    Delete old Userlog.BAK                    }
  771.         Err := Rename(ULPath, vRefNum, TheBAK);                {    Rename Userlog to Userlog.BAK        }
  772.         Err := Rename(NewULog, vRefNum, ULPath);            {    Rename Userlog.$$$ to Userlog        }
  773.  
  774.         Err := FSOpen(TheBAK, vRefNum, ULRefNum);
  775.         Err := FSDelete(concat(BackupPath, 'UL.bak'), vRefNum);
  776.         Err := FSDelete(concat(BackupPath, 'UL.sit'), vRefNum);
  777.         Err := Create(concat(BackupPath, 'UL.bak'), vRefNum, 'ULED', 'ULOG');
  778.         if Err = noErr then
  779.             Err := FSOpen(concat(BackupPath, 'UL.bak'), vRefNum, ULCopyRefNum);
  780.         HowManyCharacters := MaxFileChars;
  781.         FilePointer := NewPtr(HowManyCharacters);
  782.         while (Err = noErr) & (HowManyCharacters = MaxFileChars) do
  783.             begin
  784.                 Err := FSRead(ULRefNum, HowManyCharacters, FilePointer);
  785.                 Err := FSWrite(ULCopyRefNum, HowManyCharacters, FilePointer)
  786.             end;
  787.         Err := FSClose(ULRefNum);
  788.         Err := FSClose(ULCopyRefNum);
  789.         Err := FSDelete(TheBAK, vRefNum);                        {    Delete old Userlog.BAK                    }
  790.  
  791.         if StuffItAvail & UseStuffit then
  792.             begin
  793.                 EraseRect(dispRect);
  794.                 MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  795.                 DrawString('Stuffing Userlog.bak…');
  796.                 Err := GetDirInfo(BackupPath, tempWD);    {••• fix later}
  797.  
  798.                 if Err = NoErr then
  799.                     begin
  800.                         with destFile do
  801.                             begin
  802.                                 v := tempVRef;
  803.                                 d := tempDirRef;
  804.                                 n := 'UL.sit';
  805.                                 method := Better;
  806.                                 deleteIt := false;
  807.                             end;
  808.                         StuffFilesHandle := FileListHdl(NewHandle((sizeOf(FileListHdl)) + (1 * sizeOf(filespec))));
  809.                         with StuffFilesHandle^^ do
  810.                             begin
  811.                                 count := 1;
  812.                                 with ary[0] do
  813.                                     begin
  814.                                         v := tempVRef;
  815.                                         d := tempDirRef;
  816.                                         n := 'UL.bak';
  817.                                         method := Better;
  818.                                         deleteIt := true
  819.                                     end
  820.                             end;
  821.                         HLock(StuffResource);
  822.                         Err := Stuff(StuffFilesHandle, @destFile, 'Shrinking UserLog', StuffResource^);
  823.                         HUnlock(StuffResource);
  824.                         DisposHandle(Handle(StuffFilesHandle));
  825.                         CloseWD(tempVRef);
  826.                         SetPort(savePort) { Only needed when calling v1.0 of the engine}
  827.                     end
  828.             end
  829.     end;
  830.  
  831. { ------------------------------------------------------ }
  832.  
  833.     procedure ResetLog (LogPath: STR255);
  834.  
  835.         var
  836.             TheLogArchive, LogString, TheTempFile: STR255;
  837.             LogRef, LogArcRef, TempRef: integer;
  838.             fndrInfo: FInfo;
  839.             Quit: boolean;
  840.             LogPos: longint;
  841.  
  842.     begin
  843.         Err := FSOpen(LogPath, vRefNum, LogRef);
  844.         Err := GetEOF(LogRef, logicalEOF);
  845.         TheLogArchive := concat(LogPath, '.Arch');
  846.         Err := GetFInfo(TheLogArchive, vRefNum, fndrInfo);
  847.         if Err = noErr then
  848.             begin
  849.                 with fndrInfo do
  850.                     begin
  851.                         fndrInfo.fdType := 'TEXT';
  852.                         fndrInfo.fdCreator := TEXTType
  853.                     end;
  854.                 Err := SetFInfo(TheLogArchive, vRefNum, fndrInfo);
  855.             end
  856.         else
  857.             Err := Create(TheLogArchive, vRefNum, TEXTType, 'TEXT');
  858.         Err := FSOpen(TheLogArchive, vRefNum, LogArcRef);
  859.         Err := SetFPos(LogArcRef, fsFromLEOF, 0);
  860.  
  861.         Quit := false;
  862.         Err := GetFPos(LogRef, LogPos);
  863.  
  864.         while (LogPos < logicalEOF) and (not Quit) do
  865.             begin
  866.                 Err := ReadALine(LogRef, LogString);
  867.                 if pos(DateString, LogString) <> 1 then
  868.                     Err := WrLn(LogArcRef, LogString)
  869.                 else
  870.                     Quit := true;
  871.                 Err := GetFPos(LogRef, LogPos);
  872.             end;
  873.  
  874.         Err := FSClose(LogArcRef);
  875.         TheTempFile := concat(LogPath, '.$$$');
  876.         Err := FSDelete(TheTempFile, vRefNum);
  877.         Err := Create(TheTempFile, vRefNum, TEXTType, 'TEXT');
  878.         Err := FSOpen(TheTempFile, vRefNum, TempRef);
  879.  
  880.         if pos(DateString, LogString) = 1 then
  881.             Err := WrLn(TempRef, LogString);
  882.  
  883.         while (LogPos < logicalEOF) do
  884.             begin
  885.                 Err := ReadALine(LogRef, LogString);
  886.                 Err := WrLn(TempRef, LogString);
  887.                 Err := GetFPos(LogRef, LogPos);
  888.             end;
  889.  
  890.         Err := FSClose(TempRef);
  891.         Err := FSClose(LogRef);
  892.         Err := FSDelete(LogPath, vRefNum);
  893.         Err := Rename(TheTempFile, vRefNum, LogPath);
  894.  
  895.     end;
  896.  
  897. { ------------------------------------------------------ }
  898.  
  899.     procedure DoMonthlyArc;
  900.  
  901.         var
  902.             MonthlyName: str255;
  903.             ThisMonth, ThisYear: integer;
  904.  
  905.     begin
  906.         if Today.Day = 1 then
  907.             begin
  908.                 if Today.Month = 1 then
  909.                     begin
  910.                         ThisMonth := 12;
  911.                         ThisYear := pred(Today.Year)
  912.                     end
  913.                 else
  914.                     begin
  915.                         ThisMonth := pred(Today.Month);
  916.                         ThisYear := Today.Year;
  917.                     end;
  918.                 MonthlyName := concat(BackupPath, 'CallerLog ', BigString(ThisMonth), '/', stringOf((ThisYear mod 100) : 1));
  919.                 Err := Rename(concat(BackupPath, 'CallerLog.Arch'), vRefNum, MonthlyName);
  920.                 Err := Create(concat(BackupPath, 'CallerLog.Arch'), vRefNum, TEXTType, 'TEXT')
  921.             end
  922.     end;
  923.  
  924. { ------------------------------------------------------ }
  925.  
  926.     procedure TrimLog (LogPath: STR255);
  927.  
  928.         const
  929.             MaxBufSize = 10000;
  930.  
  931.         type
  932.             Buffer = packed array[1..MaxBufSize] of char;
  933.             BufPtr = ^Buffer;
  934.             BufHdl = ^BufPtr;
  935.  
  936.         var
  937.             TempLogArchive, LogString: STR255;
  938.             LogRef, TempLogRef: integer;
  939.             fndrInfo: FInfo;
  940.             TransferChars: longint;
  941.             MyBufHdl: BufHdl;
  942.  
  943.     begin
  944.         Err := FSOpen(LogPath, vRefNum, LogRef);
  945.         Err := GetEOF(LogRef, logicalEOF);
  946.  
  947.         if (logicalEOF > (TabbyLimitSize * 1024)) then
  948.             begin
  949.                 TempLogArchive := concat(LogPath, '$$$');
  950.                 Err := GetFInfo(TempLogArchive, vRefNum, fndrInfo);
  951.                 if Err = noErr then
  952.                     begin
  953.                         fndrInfo.fdType := 'TEXT';
  954.                         fndrInfo.fdCreator := TEXTType;
  955.                         Err := SetFInfo(TempLogArchive, vRefNum, fndrInfo);
  956.                     end
  957.                 else
  958.                     Err := Create(TempLogArchive, vRefNum, TEXTType, 'TEXT');
  959.                 Err := FSOpen(TempLogArchive, vRefNum, TempLogRef);
  960.                 TransferChars := MaxBufSize;
  961.                 MyBufHdl := BufHdl(NewHandle(MaxBufSize));
  962.                 HLock(Handle(MyBufHdl));
  963.                 Err := SetFPos(LogRef, fsFromLEOF, -(TabbyLimitSize * 1024));
  964.                 Err := ReadALine(LogRef, LogString);                            {discard any partial lines}
  965.                 while (Err = NoErr) do
  966.                     begin
  967.                         Err := FSRead(LogRef, TransferChars, Ptr(MyBufHdl^));
  968.                         if (TransferChars > 0) then
  969.                             Err := FSWrite(TempLogRef, TransferChars, Ptr(MyBufHdl^))
  970.                     end;
  971.                 HUnlock(Handle(MyBufHdl));
  972.                 DisposHandle(Handle(MyBufHdl));
  973.                 Err := FSClose(TempLogRef);
  974.                 Err := FSClose(LogRef);
  975.                 Err := FSDelete(LogPath, vRefNum);
  976.                 Err := Rename(TempLogArchive, vRefNum, LogPath)
  977.             end
  978.         else
  979.             Err := FSClose(LogRef)
  980.     end;
  981.  
  982. { ------------------------------------------------------ }
  983.  
  984.     var
  985.         itemType: integer;
  986.         itemHandle: Handle;
  987.  
  988. begin
  989.     CurrentResFile := CurResFile;
  990.     GetSTR;
  991.     MakeDateline;
  992.     if Button then
  993.         ConfigureDialog        { If user is holding down the mouse button, reconfigure and end }
  994.     else
  995.         begin
  996.             DialogPointer := GetNewDialog(runDlog, nil, POINTER(-1));
  997.             SetPort(DialogPointer);
  998.             DrawDialog(DialogPointer);
  999.             TextFont(Geneva);
  1000.             TextSize(9);
  1001.             ForeColor(blueColor);
  1002.             getDItem(DialogPointer, 3, itemType, itemHandle, dispRect);
  1003.             EraseRect(dispRect);
  1004.             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1005.             DrawString(concat('Version ', VERSION, ' of ', Compdate));
  1006.             ForeColor(redColor);
  1007.             getDItem(DialogPointer, 2, itemType, itemHandle, dispRect);
  1008.             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1009.             DrawString('Reading Tabby info…');
  1010.             HelloTabby;    { find out what's next on the launchpad }
  1011.             EraseRect(dispRect);
  1012.             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1013.             DrawString('Reading Config file…');
  1014.  
  1015.             if ReadConfig then
  1016.                 begin
  1017.                     StuffItAvail := FindStuffIt;
  1018.                     EraseRect(dispRect);
  1019.                     ULRecSize := sizeOf(UserRecord);
  1020.                     if Backup then
  1021.                         begin
  1022.                             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1023.                             DrawString('Backing up UserLog…');
  1024.                             BackUserLog;
  1025.                             EraseRect(dispRect)
  1026.                         end;
  1027.                     if SortUL then
  1028.                         begin
  1029.                             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1030.                             DrawString('Sorting UserLog…');
  1031.                             SortUserLog;
  1032.                             EraseRect(dispRect)
  1033.                         end;
  1034.                     if ZeroMin then
  1035.                         begin
  1036.                             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1037.                             DrawString('Clearing minutes used…');
  1038.                             ZeroMinutes;
  1039.                             EraseRect(dispRect)
  1040.                         end;
  1041.                     if ResetCL then
  1042.                         begin
  1043.                             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1044.                             DrawString('Resetting CallerLog…');
  1045.                             ResetLog(CLPath);
  1046.                             if MonthlyCLArc then
  1047.                                 DoMonthlyArc;
  1048.                             EraseRect(dispRect)
  1049.                         end;
  1050.                     if ResetTL then
  1051.                         begin
  1052.                             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1053.                             DrawString('Resetting Tabby Log…');
  1054.                             ResetLog(':Tabby:Tabby Log');
  1055.                             EraseRect(dispRect)
  1056.                         end;
  1057.                     if TabbyLimit then
  1058.                         begin
  1059.                             MoveTo(dispRect.left + 2, dispRect.bottom - 2);
  1060.                             DrawString('Trimming Tabby Log…');
  1061.                             TrimLog(':Tabby:Tabby Log.Arch');
  1062.                             EraseRect(dispRect)
  1063.                         end;
  1064.                 end;        {    if ReadConfig        }
  1065.             if StuffItAvail then
  1066.                 CloseStuffIt;
  1067.             DisposDialog(DialogPointer);
  1068.             if NextLaunch <> '' then
  1069.                 LaunchNextAppl
  1070.         end
  1071. end.